Info-Mac 4/Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso/Development/Source/MungeImage Source/DInstaller.p

Text File | 1994-05-11 | 3KB | 157 lines

{$I-}

program DInstaller;
    uses
        EPPC, AppleEvents, RequiredEventSupport, MyDriver;

    function GetRegA7: Ptr;
    inline
        $2E8F;

    var
        drvr_ref: integer;

    var
        have_opened: boolean;

    function DoODoc (fss: FSSpec): OSErr;
        var
            err: OSErr;
            pb: ParamBlockRec;
    begin
        have_opened := true;
        with pb do begin
            ioCRefNum := drvr_ref;
            csCode := 666;
            ioMisc := @fss;
        end; (* with *)
        err := PBControlSync(@pb);
        if err <> noErr then begin
            SysBeep(10);
        end; (* if *)
        DoODoc := err;
    end; (* DoODoc *)

    procedure CleanUpImageHandles;
        var
            junk: OSErr;
            pb: ParamBlockRec;
    begin
        with pb do begin
            ioCRefNum := drvr_ref;
            csCode := 667;
        end; (* with *)
        junk := PBControlSync(@pb);
    end; (* CleanUpImageHandles *)

    function FindFirstVolume (var vref: integer): boolean;
        var
            ndx: integer;
            vpb: HParamBlockRec;
            err: OSErr;
    begin
        FindFirstVolume := false;
        ndx := 1;
        repeat
            vpb.ioCompletion := nil;
            vpb.ioNamePtr := nil;
            vpb.ioVolIndex := ndx;
            err := PBGetVInfo(@vpb, false);
            if (err = noErr) & (vpb.ioVDRefNum = drvr_ref) then begin
                vref := vpb.ioVRefNum;
                FindFirstVolume := true;
                leave;
            end; (* if *)
            ndx := ndx + 1;
        until err <> noErr;
    end; (* FindFirstVolume *)

    function UnmountVolumes: boolean;
        var
            err: OSErr;
            vref: integer;
    begin
        err := noErr;
        while (err = noErr) & FindFirstVolume(vref) do begin
            err := UnmountVol(nil, vref);
        end; (* while *)
        CleanUpImageHandles;
        UnmountVolumes := (err = noErr);
    end; (* UnmountVolumes *)

    var
        quitNow: boolean;

    function DoQuit: OSErr;
    begin
        quitNow := true;
        DoQuit := noErr;
    end; (* DoQuit *)

    var
        junkbool: boolean;
        event: EventRecord;
        err: OSErr;
        junk: OSErr;
        junk_vref: integer;
        psn: ProcessSerialNumber;
        proc_info: ProcessInfoRec;
        response: longint;
begin
    if (Gestalt(gestaltSystemVersion, response) <> noErr) | (response < $700) then begin
        ExitToShell;
    end; (* if *)
    InitGraf(@thePort);
    if GetCurrentProcess(psn) <> noErr then begin
        ExitToShell;
    end; (* if *)
    proc_info.processInfoLength := sizeof(proc_info);
    proc_info.processName := nil;
    proc_info.processAppSpec := nil;
    if GetProcessInformation(psn, proc_info) <> noErr then begin
        ExitToShell;
    end; (* if *)
    if (band(proc_info.processMode, modeOnlyBackground) = 0) then begin
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil)
    end; (* if *)
    SetApplLimit(Ptr(longint(GetRegA7) - $2000));
    MaxApplZone;
    MoreMasters;

    err := InitAppleEvents(nil, @DoODoc, nil, @DoQuit);
    if err = noErr then begin
        err := InstallRAMDriver('.MungeImage', drvr_ref, true);
        if err = noErr then begin
            quitNow := false;
            while not quitNow do begin
                junkbool := WaitNextEvent(everyEvent, event, maxlongint, nil);
                CleanUpImageHandles;
                case event.what of
                    keyDown:
                        quitNow := true;
                    kHighLevelEvent:
                        junk := AEProcessAppleEvent(event);
                    otherwise
                        ;
                end; (* case *)
                if have_opened & not (FindFirstVolume(junk_vref)) then begin
                    quitNow := true;
                end; (* if *)
                if quitNow then begin
                    if not UnmountVolumes | (CloseDriver(drvr_ref) <> noErr) then begin
                        quitNow := false;
                    end; (* if *)
                end; (* if *)
            end; (* while *)
            err := RemoveRAMDriver(drvr_ref);
        end
        else begin
            SysBeep(10);
        end; (* if *)
    end; (* if *)
end. (* DInstaller *)